home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / ENVIRON.SEQ < prev    next >
Text File  |  1987-12-01  |  3KB  |  89 lines
  1. \ ENVIRON.SEQ   Environment manipulation words          by Tom Zimmer
  2.  
  3. : evseg         ( --- n1 )      \ Return the segment of environment $.
  4.                 44 @ ;
  5.  
  6. : envsize       ( --- n1 )      \ Calculate the environment $ size.
  7.                 ?cs: evseg - 2047 min 16 * ;
  8.  
  9. : "envfind      ( a1 n1 --- n2 bool )
  10.                 caps dup @ >r off
  11.                 evseg SSEG !            \ Set the search segment
  12.                 0 envsize search
  13.                 ?CS: SSEG !             \ Restore the search segment
  14.                 r> caps ! ;
  15.  
  16. : .env          ( --- )         \ print the environment string
  17.                 0 envsize bounds    cr
  18.                ?do      evseg i c@l 0=
  19.                         if      cr
  20.                         else    evseg i c@l emit
  21.                         then    evseg i @l 0= ?leave
  22.                 loop    ;
  23.  
  24. handle comspec$
  25.  
  26. : comspec@      ( --- )         \ extract the command spec
  27.                 " COMSPEC=" "envfind 0=
  28.                 abort" Couldn't find Command Spec."
  29.                 8 + envsize swap
  30.                 comspec$ dup clr-hcb >nam -rot
  31.                 do      evseg i c@l 0= ?leave
  32.                         evseg i c@l over c! 1+
  33.                         comspec$ c@ 1+ comspec$ c!
  34.                 loop    drop ;
  35.  
  36. : .comspec      ( --- ) comspec@ comspec$ count type ;
  37.  
  38. handle me$
  39.  
  40. : me@           ( --- ) \ extract my own execution name string
  41.                 me$ dup off 2 "envfind 0=
  42.                 abort" Couldn't find my execution name."
  43.                 4 + envsize swap
  44.                 me$ dup clr-hcb >nam -rot
  45.                 do      evseg i c@l 0= ?leave
  46.                         evseg i c@l over c! 1+
  47.                         me$ c@ 1+ me$ c!
  48.                 loop    drop ;
  49.  
  50. : .me           ( --- ) me@ me$ count type ;
  51.  
  52. comment:
  53.  
  54. envsize       ( --- n1 )
  55.         Return the maximum size the environment can be in bytes.
  56.  
  57. .env          ( --- )
  58.         Print the environment string used by the system.
  59.  
  60. "envfind      ( a1 n1 --- n2 bool )
  61.         Find the string a1 n1 in the environment, returning
  62.         bool true if found, and n2 the offset into env$ where it
  63.         was found. N2 is the offset to the BEGINNING of the
  64.         string searched for.
  65.  
  66. comspec$
  67.         Storage space for the command spec string.
  68.  
  69. comspec@      ( --- )
  70.         Extract the command spec from the environment string.
  71.  
  72. .comspec      ( --- )
  73.         Print the command spec.
  74.  
  75. me$
  76.         Storage space for the execution string used to execute
  77.         this forth currently running.
  78.  
  79. me@           ( --- )
  80.         Extract the execution string from the environment, and
  81.         place it in the string ME$
  82.  
  83. .me           ( --- )
  84.         Print the execution string after extracting it.
  85.  
  86. comment;
  87.  
  88.  
  89.